      SUBROUTINE PROCOM
C! Produce the COMMON block table
      INCLUDE 'params.h'
      INCLUDE 'lunits.h'
      INCLUDE 'trecom.h'
      INCLUDE 'tables.h'
      PARAMETER (LLINE=130,LOFF=10,MLINE=(LLINE-LOFF)/2,LPAGE=50)
      CHARACTER*(LLINE) CLINE
      CHARACTER*(LLINE+1) CTEMP
C
      CTEMP(:LOFF) = ' '
      CTEMP(LOFF+1:LOFF+1) = '+'
      DO 7 I=1,LLINE-LOFF-1
        CTEMP(LOFF+1+I:LOFF+1+I) = '-'
    7 CONTINUE
      CTEMP(LLINE+1:LLINE+1) = '+'
C
C
      WRITE(LOUT,'(A)') ' '
      WRITE(LOUT,'(A)') ' PROCOM Begins ....'
      WRITE(LOUT,'(A)') ' '
C
C write top page
C
      WRITE(LOUTCO,666)
  666 FORMAT(1X,20('*'),'              ProCom             ',20('*'),
     &     /,1X,20(' '),'              ======             ',20(' '),
     &     ///,1X,20(' '),' Module names appear along x-axis',
     &     /,1X,20(' '),' COMMON block names along y-axis',
     &     /,
     &     /,1X,20(' '),' <Y>  ==> COMMON used in module'
     &     /,1X,20(' '),' <N>  ==> COMMON not used (but is DECLARED)',
     &     /,1X,20(' '),' < >  ==> COMMON not DECLARED',
     &     /,1X,20('*'),'*********************************',20('*'))
      NPAGE = 0
      NCOLS = 0
    1 CONTINUE
      IF(NPAGE*LPAGE/2.GE.NCOMM) GOTO 110
    2 CONTINUE
      IF(NCOLS.GE.NPROC) GOTO 100
C
C move to new page
C
      WRITE(LOUTCO,490)
  490 FORMAT(1H1)
      DO 5 ILET = 1,6
        CLINE(:) = ' '
        DO 10 IPRO=1,MIN(NPROC,MLINE)
          IPRO1 = IPRO+NCOLS
          IF(IPRO1.GT.NPROC) GOTO 11
          IPOS = IPRO*2 + LOFF
          IF(LENOCC(PROCED_NAME(IPRO1)).LT.ILET) THEN
            CLINE(IPOS:IPOS) = ' '
          ELSE
            CLINE(IPOS:IPOS) = PROCED_NAME(IPRO1)(ILET:ILET)
          ENDIF
   10   CONTINUE
   11   CONTINUE
        WRITE(LOUTCO,'(A)') CLINE(:LLINE)
    5 CONTINUE
C
C now loop over all common names
C
      WRITE(LOUTCO,'(A)') CTEMP(:LLINE)
      DO 15 ICOM=1,MIN(NCOMM,LPAGE/2)
        ICOM1 = ICOM+NPAGE*LPAGE/2
        IF(ICOM1.GT.NCOMM) GOTO 16
        CLINE = COMMON_NAME(ICOM1)
        LINE = LENOCC(CLINE)
C
C now find procedures using this common
C loop over them, constructing cline
C
        DO 20 IPROC=NCOLS+1,MIN(NCOLS+MLINE,NPROC)
          IPOS1 = IPROC - NCOLS
          IPOS = IPOS1*2 + LOFF -1
          CLINE(IPOS:IPOS) = COMMON_USED(IPROC,ICOM)
   20   CONTINUE
        CLINE(10:10) = '|'
        CLINE(LLINE:LLINE) = '|'
        WRITE(LOUTCO,'(1X,A)') CLINE(:LLINE)
        CLINE = ' '
        CLINE(10:10) = '|'
        CLINE(LLINE:LLINE) = '|'
C       WRITE(LOUTCO,'(1X,A)') CLINE(:LLINE)
   15 CONTINUE
   16 CONTINUE
      WRITE(LOUTCO,'(A)') CTEMP(:LLINE)
   90 CONTINUE
      NCOLS = NCOLS+MLINE
      GOTO 2
  100 CONTINUE
      NPAGE = NPAGE+1
      NCOLS = 0
      GOTO 1
  110 CONTINUE
      WRITE(LOUT,'(A)') ' PROCOM Finished'
      END
